home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 20 / Cream of the Crop 20 (Terry Blount) (1996).iso / os2 / xdsn217.zip / SAMPLES / SIMPLE / e.mod < prev    next >
Text File  |  1995-06-28  |  2KB  |  96 lines
  1. (* Print first 'NDigits' digits of 'e'.
  2.  *
  3.  * Originally written in Algol by Serge Batalov
  4.  * Rewritten in Modula-2 and modified by Eugene Nalimov, Pavel Zemtsov
  5.  *
  6.  *)
  7.  
  8. <*- CHECKINDEX *>
  9. <*- CHECKRANGE *>
  10. <*- COVERFLOW  *>
  11. <*- IOVERFLOW  *>
  12.  
  13. MODULE e;
  14.  
  15. IMPORT InOut;
  16.  
  17. CONST
  18.       M       = 100000;       (* Max # OF digits           *)
  19.       NDigits = 20000;        (* actual # of digits        *)
  20.       N       = 4;            (* One "digit" is 0..10 ** N *)
  21.       P       = 10000;        (* 10 ** N                   *)
  22.  
  23. VAR  x, y: ARRAY [1..M DIV N+5] OF CARDINAL;
  24.         s: ARRAY [1..M]         OF CHAR;
  25.   a, b, r: CARDINAL;
  26.  
  27. PROCEDURE WrDigits (n, m: CARDINAL);
  28. BEGIN
  29.     IF m <> 0 THEN
  30.         WrDigits (n DIV 10, m - 1);
  31.         s [r] := CHR (ORD ('0') + n MOD 10);
  32.         INC (r);
  33.     END;
  34. END WrDigits;
  35.  
  36. PROCEDURE Calc (d: INTEGER);
  37. VAR m, e, b: INTEGER;
  38.     k, l, c: CARDINAL;
  39. BEGIN
  40.     IF d REM 100 <> 0 THEN
  41.         d := (d / 100 + 1) * 100;
  42.     END;
  43.     e := d / N + 4;
  44.     FOR b:=1 TO e DO
  45.         x [b] := 0;
  46.         y [b] := 0;
  47.     END;
  48.     y [1] := P;
  49.     l := 0;
  50.     c := 1;
  51.     FOR m:=1 TO e DO
  52.         LOOP
  53.             INC (c);
  54.             FOR b:=m TO e DO
  55.                 l := y [b] + l * P;
  56.                 y [b] := l DIV c;
  57.                 INC (x [b], y [b]);
  58.                 DEC (l, c * y [b]);
  59.             END;
  60.             IF y [m] < c THEN
  61.                 EXIT;
  62.             END;
  63.             l := 0;
  64.         END;
  65.         l := y [m];
  66.     END;
  67.     l := 0;
  68.     FOR b:=e TO 1 BY -1 DO
  69.         k := x [b] + l;
  70.         l := k DIV P;
  71.         x [b] := k - l * P;
  72.     END;
  73.     r := 1;
  74.     FOR b:=1 TO e-4 DO
  75.         WrDigits (x [b], N);
  76.     END;
  77. END Calc;
  78.  
  79. BEGIN
  80.     InOut.WriteString ("Please wait, calculating first");
  81.     InOut.WriteInt    (NDigits, 0);
  82.     InOut.WriteString (" digits of 'e'...");
  83.     InOut.WriteLn;
  84.  
  85.     Calc (NDigits);
  86.  
  87.     InOut.WriteString ('e = 2.');
  88.     FOR b:=1 TO NDigits BY 50 DO
  89.         FOR a:=0 TO 49 DO
  90.             InOut.Write (s [a + b]);
  91.         END;
  92.         InOut.WriteLn;
  93.         InOut.WriteString ('      ');
  94.     END;
  95. END e.
  96.